perm filename PARSE2.SAI[PNT,HE] blob
sn#328795 filedate 1978-01-16 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00004 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 ENTRY
C00005 00003 ! parse: number,nums,GTOKEN,namefile
C00016 00004 INTERNAL SIMPLE PROCEDURE SEMICOL_READ
C00025 ENDMK
C⊗;
ENTRY;
BEGIN "PARSER"
REQUIRE "MACROS.SAI[PNT,HE]" SOURCE_FILE;
REQUIRE "RECORD.DEF[PNT,HE]" SOURCE_FILE;
EXTERNAL BOOLEAN $OUT; ! if true output is required;
EXTERNAL INTEGER $TTYCH; ! channel # to output any tty input;
EXTERNAL STRING $LINE,$NEXT,$TAIL,TOKEN;
EXTERNAL INTEGER $RETAB,$SKTAB,$SPCTAB,$SCNTAB,$NUMTAB,$ALFTAB;
EXTERNAL INTEGER $EOF,$BRCHR;
EXTERNAL STRING OLDOBJ;
EXTERNAL INTEGER #TOKEN; ! type of last token read by GTOKEN;
EXTERNAL BOOLEAN STOKEN; ! true if the next token to be
read is yet in TOKEN;
EXTERNAL RPTR(TREE) PROCEDURE NWTREE(RPTR(SCALAR,VECTOR,ROT,TRANS,FRAME)A;INTEGER B);
EXTERNAL RPTR(TREE) PROCEDURE DCDSYM(STRING SYMB);
EXTERNAL STRING ARRAY $SYNMSG[0:34];
EXTERNAL PROCEDURE ERROR(STRING ERR1,ERR2);
EXTERNAL PROCEDURE ESC_P;
! parse: number,nums,GTOKEN,namefile ;
! checks if num is a number or @;
SIMPLE BOOLEAN PROCEDURE NUMBER(INTEGER NUM);
BEGIN "N"
IF 48≤NUM≤57 OR NUM=64 THEN RETURN(TRUE) ELSE RETURN(FALSE);
END "N";
! checks if the string word contains only numbers;
SIMPLE BOOLEAN PROCEDURE NUMS(STRING WORD);
BEGIN "NS"
STRING WW; INTEGER BR;
WW←SCAN(WORD,$NUMTAB,BR);
IF BR=0 THEN RETURN (TRUE) ELSE RETURN (FALSE);
END "NS";
! returns true if the last TOKEN is a terminal character, CR or ;
INTERNAL SIMPLE BOOLEAN PROCEDURE FINAL;
BEGIN "FIN"
IF TOKEN=SEMC OR TOKEN=CR
THEN RETURN(TRUE)
ELSE RETURN(FALSE);
END "FIN";
! returns in head next token.If erroneous token is null;
INTERNAL PROCEDURE GTOKEN (BOOLEAN NONSTOP(TRUE));
BEGIN "GTOKEN"
STRING WORD,WORD2;
INTEGER BRPARS; LABEL AGAIN;
! reads next RTOKEN using the indicated breaktable;
define rtoken(aaa)=<scan($tail, aaa ,brpars)>;
IF STOKEN THEN BEGIN STOKEN←FALSE;RETURN;END;
AGAIN: WORD←NULL;#TOKEN ←UNDECLARED_TYPE;
RTOKEN($SPCTAB); ! skips blanks;
WORD←WORD&RTOKEN($RETAB); ! reads first RTOKEN;
IF WORD=NULL
THEN IF BRPARS="."
THEN BEGIN ! no object read, period found;
RTOKEN($SKTAB);
RTOKEN($ALFTAB); ! reads one character;
IF NUMBER(BRPARS)
THEN BEGIN
WORD←"."&RTOKEN($NUMTAB); ! reads until finds numbers;
#TOKEN ←REAL_TYPE; ! floating number read;
END
ELSE BEGIN
WORD←".";
#TOKEN ←OPERATOR_TYPE; ! period is only a punctuation mark;
END;
END
ELSE IF BRPARS=CR AND NONSTOP
THEN BEGIN
! a new line is required and then the RTOKEN is read;
$LINE←INCHWL; ESC_P;
$NEXT ←$NEXT &" "&$LINE;
IF $OUT THEN CPRINT($TTYCH,$LINE,CRLF);
$TAIL←SCAN($LINE,$SCNTAB,$BRCHR);
IF $BRCHR=0 THEN $TAIL←$TAIL&CR;
GO TO AGAIN;
END
ELSE IF BRPARS="⊗"
THEN BEGIN
WORD←OLDOBJ;
RTOKEN($SKTAB);
#TOKEN←ID_TYPE;
END
ELSE BEGIN
WORD←BRPARS;
RTOKEN($SKTAB);
#TOKEN ←OPERATOR_TYPE; ! punctuation mark found;
END
ELSE IF BRPARS="."
THEN IF NUMS(WORD)
THEN BEGIN
WORD←WORD&".";
RTOKEN($SKTAB);
RTOKEN($ALFTAB); ! reads one character;
IF NUMBER(BRPARS)
THEN BEGIN ! there are more numbers;
WORD←WORD&RTOKEN($NUMTAB);
#TOKEN ←REAL_TYPE; ! floating number read;
END
ELSE BEGIN
#TOKEN ←REAL_TYPE; ! floating number read;
END;
END;
TOKEN←WORD;
! checks if RTOKEN is an integer number;
IF TOKEN
THEN
IF #TOKEN =UNDECLARED_TYPE
THEN BEGIN
WORD2←SCAN(WORD,$ALFTAB,BRPARS); ! reads one character;
IF NUMBER(BRPARS)
THEN BEGIN ! if first ch. is a number;
WORD2←SCAN(WORD,$NUMTAB,BRPARS);
IF BRPARS=0
THEN BEGIN ! only numbers found;
#TOKEN ←INT_TYPE; ! integer number read;
TOKEN←WORD2;
END
ELSE BEGIN
TOKEN←NULL; ! incorrect TOKEN;
ERROR ($SYNMSG[31],NULL);
END
END;
END;
IF #TOKEN=UNDECLARED_TYPE
THEN IF EQU(TOKEN,"MOVE") OR EQU(TOKEN,"OPEN") OR EQU(TOKEN,"CLOSE")
OR EQU(TOKEN,"WRITE") OR EQU(TOKEN,"READ") OR EQU(TOKEN,"SAVE")
OR EQU(TOKEN,"CLOSE_FILES") OR EQU(TOKEN,"SAVE_FILES")
OR EQU(TOKEN,"DRIVE") OR EQU(TOKEN,"MOVEX") OR EQU(TOKEN,"MOVEY")
OR EQU(TOKEN,"MOVEZ") OR EQU(TOKEN,"POS") OR EQU(TOKEN,"ORIENT")
OR EQU(TOKEN,"REL") OR EQU(TOKEN,"WRT") OR EQU(TOKEN,"FRAME")
OR EQU(TOKEN,"VECTOR") OR EQU(TOKEN,"SCALAR") OR EQU(TOKEN,"TRANS")
OR EQU(TOKEN,"DISTANCE") OR EQU(TOKEN,"CONSTRUCT") OR EQU(TOKEN,"TO")
OR EQU(TOKEN,"BY") OR EQU(TOKEN,"INPUT") OR EQU(TOKEN,"PARK")
OR EQU(TOKEN,"ROT")
THEN #TOKEN←RES_TYPE
ELSE IF TREE:DTYPE[DCDSYM(TOKEN)]
THEN #TOKEN←ID_TYPE;
END "GTOKEN";
! reads a file name and returns it ;
INTERNAL STRING PROCEDURE NAMEFILE;
BEGIN "NAMEFILE"
STRING NAME;
GTOKEN;
IF #TOKEN =UNDECLARED_TYPE
THEN BEGIN "FILE"
NAME←TOKEN; ! name of file;
GTOKEN(FALSE);
IF #TOKEN =REAL_TYPE
THEN BEGIN "NUM" ! if extension is a number;
STRING P;
P←LOP(TOKEN);
IF P="."
THEN BEGIN
NAME←NAME&"."&TOKEN;
GTOKEN(FALSE);
END
ELSE ERROR($SYNMSG[21],$SYNMSG[25]);
END "NUM"
ELSE IF EQU(TOKEN,".")
THEN BEGIN "EXT" ! extension;
GTOKEN;
IF #TOKEN =UNDECLARED_TYPE
THEN BEGIN
NAME←NAME&"."&TOKEN;
GTOKEN(FALSE);
END
ELSE ERROR($SYNMSG[21],$SYNMSG[25]);
END "EXT";
END "FILE"
ELSE ERROR($SYNMSG[23],$SYNMSG[25]);
IF TOKEN="["
THEN BEGIN "PPN" ! there is ppn;
GTOKEN;
IF #TOKEN =UNDECLARED_TYPE OR #TOKEN =INT_TYPE
THEN BEGIN "PR"
NAME←NAME&"["&TOKEN;
GTOKEN;
IF TOKEN=","
THEN BEGIN "PN"
GTOKEN; ! there is pn;
IF #TOKEN =UNDECLARED_TYPE
THEN BEGIN "PAREN"
NAME←NAME&","&TOKEN;
GTOKEN;
IF TOKEN="]"
THEN NAME←NAME&"]"
ELSE ERROR($SYNMSG[4],$SYNMSG[25]);
END "PAREN"
ELSE ERROR($SYNMSG[21],$SYNMSG[25]);
END "PN"
ELSE ERROR($SYNMSG[1],$SYNMSG[25]);
END "PR"
ELSE BEGIN
PRINT("--→ integer number ",$SYNMSG[25],"OR ");
ERROR($SYNMSG[21],$SYNMSG[25]);
END
END "PPN"
ELSE STOKEN←TRUE; ! was $tail←token&$tail;
RETURN(NAME);
END "NAMEFILE";
INTERNAL SIMPLE PROCEDURE SEMICOL_READ;
BEGIN
GTOKEN(FALSE);
IF NOT FINAL THEN ERROR($SYNMSG[0],$SYNMSG[25]);
END;
INTERNAL SIMPLE PROCEDURE RPAR_READ;
BEGIN
GTOKEN;
IF TOKEN≠")" THEN ERROR($SYNMSG[6],$SYNMSG[25]);
END;
INTERNAL SIMPLE PROCEDURE LPAR_READ;
BEGIN
GTOKEN;
IF TOKEN≠"(" THEN ERROR($SYNMSG[5],$SYNMSG[25]);
END;
INTERNAL SIMPLE STRING PROCEDURE IDF_READ;
BEGIN
GTOKEN;
IF #TOKEN =INT_TYPE OR #TOKEN=REAL_TYPE OR #TOKEN=OPERATOR_TYPE
THEN ERROR($SYNMSG[21],$SYNMSG[25])
ELSE RETURN(TOKEN);
END;
INTERNAL SIMPLE STRING PROCEDURE MVFR_READ;
BEGIN
GTOKEN;
IF EQU(TOKEN,"BY")
THEN BEGIN
STOKEN←TRUE;
RETURN("BARM");
END
ELSE IF #TOKEN=ID_TYPE THEN RETURN(TOKEN)
ELSE ERROR($SYNMSG[21],$SYNMSG[25]);
END;
INTERNAL SIMPLE PROCEDURE BY_READ;
BEGIN
GTOKEN;
IF NOT EQU(TOKEN,"BY")THEN ERROR($SYNMSG[10],$SYNMSG[25]);
END;
INTERNAL SIMPLE PROCEDURE TO_READ;
BEGIN
GTOKEN;
IF NOT EQU(TOKEN,"TO") THEN ERROR($SYNMSG[14],$SYNMSG[25]);
END;
INTERNAL SIMPLE PROCEDURE INTO_READ;
BEGIN
GTOKEN;
IF NOT EQU(TOKEN,"INTO") THEN ERROR($SYNMSG[11],$SYNMSG[25]);
END;
INTERNAL SIMPLE STRING PROCEDURE HAND_READ;
BEGIN ! reads BHAND or YHAND (default= BHAND);
GTOKEN;
IF EQU(TOKEN,"BHAND") OR EQU(TOKEN,"YHAND")
THEN RETURN(TOKEN)
ELSE IF EQU(TOKEN,"TO") OR EQU(TOKEN,"BY")
THEN BEGIN
STOKEN←TRUE;
RETURN("BHAND");
END
ELSE ERROR($SYNMSG[19],$SYNMSG[25]);
END;
INTERNAL SIMPLE STRING PROCEDURE ARM_READ;
BEGIN ! reads "BARM" or "YARM" (default=BARM);
GTOKEN(FALSE);
IF EQU(TOKEN,"YARM") OR EQU(TOKEN,"BARM")
THEN BEGIN
STRING WHAT;
WHAT←TOKEN;
SEMICOL_READ;
RETURN(WHAT);
END
ELSE IF TOKEN=";" OR FINAL
THEN RETURN("BARM")
ELSE ERROR($SYNMSG[18],$SYNMSG[25]);
END;
INTERNAL SIMPLE STRING PROCEDURE DEV_READ;
BEGIN ! reads BARM/YARM/POINTER (default=POINTER);
GTOKEN(FALSE);
IF EQU(TOKEN,"POINTER") OR EQU(TOKEN,"BARM") OR EQU(TOKEN,"YARM")
THEN BEGIN
STRING POS;
POS←TOKEN;
SEMICOL_READ;
RETURN(POS);
END
ELSE IF FINAL OR TOKEN=";"
THEN RETURN("POINTER")
ELSE BEGIN
PRINT($SYNMSG[18],"OR POINTER ",$SYNMSG[25]," OR",CRLF);
ERROR($SYNMSG[0],$SYNMSG[25]);
END;
END;
INTERNAL SIMPLE STRING PROCEDURE AXIS_READ;
BEGIN ! reads XHAT/YHAT/ZHAT or X/Y/Z;
GTOKEN;
IF EQU(TOKEN,"XHAT") OR EQU(TOKEN,"YHAT") OR EQU(TOKEN,"ZHAT")
THEN RETURN(TOKEN)
ELSE IF EQU(TOKEN,"X") OR EQU(TOKEN,"Y") OR EQU(TOKEN,"Z")
THEN RETURN(TOKEN&"HAT")
ELSE ERROR($SYNMSG[17],$SYNMSG[25]);
END;
! returns the WRT frame;
INTERNAL SIMPLE STRING PROCEDURE WRTCODE;
BEGIN
STRING RELFR; ! reads "{WRT <frame_id> }" ;
GTOKEN(FALSE);
IF EQU(TOKEN,"WRT")
THEN BEGIN "C"
RELFR←IDF_READ;
SEMICOL_READ;
RETURN(RELFR);
END "C"
ELSE IF FINAL
THEN RETURN("STATION")
ELSE BEGIN "E"
PRINT($SYNMSG[0],$SYNMSG[25], " OR ");
ERROR($SYNMSG[16],$SYNMSG[25]);
END "E"
END;
! returns the FROM frame "{FROM <frame>}" or STATION;
INTERNAL SIMPLE STRING PROCEDURE FROMPART;
BEGIN
STRING ROOT;
GTOKEN(FALSE);
IF EQU(TOKEN,"FROM")
THEN BEGIN
ROOT←IDF_READ;
SEMICOL_READ;
RETURN(ROOT);
END
ELSE IF FINAL
THEN RETURN("STATION")
ELSE BEGIN
PRINT($SYNMSG[0],$SYNMSG[25]," OR ");
ERROR("--→ FROM ",$SYNMSG[25]);
END;
END;
END "PARSER";